{ Take copa file and use CURRENT decoration to transfer all chemistries
 and displacement parameters that register when ideal positions
 are compared. This transfers deco rule AND eventually instant chemical
 disorder as found in copafile, from one binding (copa) to the current one}
program REBIND;
uses common;
uses tools,inp,outp,decor,ppot,d04_header,relax;
Var
   i,j,k,o  : integer;
   ra,dr    : rsites3;
   itp,otp  : array[1..nsites] of integer;
   b	    : array[1..nsites] of boolean;
   v,dpr    : v3;
   txt	    : text;
   copaname : mystring;
   na	    : integer;
   tol	    : myreal;
   br	    : v33;
   reg	    : integer;
BEGIN
   export_occup:=false;
   readln(copaname);
   reset(txt,'INPUT/objects.def');
   readln(txt,deconame);
   readln(txt,i,o,j);
   if (j=1) then repre5:=true else repre5:=false;
   readln(txt,dpmodel);
   close(txt);
   BASIS;
   reset(txt,copaname);
   IMPORT_TILING_BODY(1,txt);
   TABLE_INIT;
   IMPORT_CONFIG(txt);
   close(txt);
   UNIT_CELL(multi);  
   for i:=1 to tnodes do
      for j:=1 to nan[i] do begin
	 na:=na+1;
	 b[na]:=true;
	 v:=n_r[i,j]; {save position + displacement}
	 itp[na]:=n_a[i,j,1];
	 otp[na]:=n_a[i,j,2];
	 para2xyz(n_para[i,j],itp[na],1,0,ra[na]); {ideal position}
	 for o:=1 to 3 do dr[na,o]:=v[o]-ra[na,o];
	 for o:=1 to 3 do ra[na,o]:=ra[na,o]+rt[i,o];
	 {for o:=1 to 3 do write(ra[na,o]:1:4,' '); writeln(na:1,' ',itp[na]:1);}
      end;
   i:=0; READ_DECO(i); {reads objects.def, ap.def}
   tol:=0.01;{Angstroms}
   dparinit;
   for i:=1 to tnodes do nan[i]:=0;
   reg:=0;
   for i:=1 to n_pxyz do nn_pxyz[i]:=0; {clean}
   for i:=1 to tnodes do NEW_NODE_OBJECTS(i,1); {ideal coordinates}
   for i:=1 to tnodes do
      for j:=1 to nan[i] do begin
	 for k:=1 to na do if b[k] then begin
	    for o:=1 to 3 do v[o]:=n_r[i,j,o]+rt[i,o];
	    if(dist3(v,ra[k])<tol) then begin {register}
	       {write(i:1,' ',j:1,' ',k:1,' ',itp[k]:1,' ',otp[k]:1,' ');
		for o:=1 to 3 do write(dr[k,o]:1:4,' ');
		writeln;}
	       b[k]:=false;
	       get_atom_basis(n_para[i,j],br);
	       mxle3(br,dr[k],dpr); {displace: cryst-2-parameter space basis}
	       add_chem_para(n_para[i,j],itp[k]);
	       n_a[i,j,1]:=itp[k]; {chemistry}
	       reg:=reg+1;
	       if(itp[k]>0)then add2para(n_para[i,j],itp[k],dpr);
	    end;
	 end;
      end;
   {new parameters}
   writeln(reg:1);
   for i:=1 to n_pxyz do
      for j:=1 to nn_pxyz[i] do if (ndps[i,j]>0) then begin
	 dpxyz[i,j]:=d_pxyz[i,j]/ndps[i,j];
      end;
   k:=0; for i:=1 to na do if b[i] then k:=k+1;
   write('Rebind ',copaname,' -> copa.rebind: ');
   if(k>0) then writeln(k:1,' atoms out of ',na:1,' have not been registered.') else writeln('all atoms were registered.');
   export_config('copa.rebind');
END.
